home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Technotools
/
Technotools (Chestnut CD-ROM)(1993).ISO
/
batch
/
bbb_v21
/
bbb.bas
next >
Wrap
BASIC Source File
|
1991-11-25
|
10KB
|
350 lines
' BBB v 2.1 - Brent's Batch Beautifier
'
' (c) 1991 by Brent Ashley
'
' last revision 25 November 1991
'
' remember to link with _STR$.OBJ under PDQ v3.0
'
' $include: 'pdqdecl.bas'
'
DEFINT A-Z
DIM Parm$(2), Box$(3), Regs as RegType
DEF FNBorder$(Num)
' extract box border character from definition string
FNBorder$ = CHR$(PDQValI(Mid$(Box$(BoxType), Num * 4 - 3, 4)))
END DEF
' box border definition strings
Box$(1) = "218 191 192 217 196 179"
Box$(2) = "201 187 200 188 205 186"
Box$(3) = "178 178 178 178 178 178"
' define ANSI escape prefix
Prefix$ = CHR$(27)+"["
CmdLine$ = COMMAND$
' work on parent environment
EnvOption 1
SetDelimitChar 32 ' space
Action$ = PDQParse(CmdLine$) 'get first action
IF Action$ = "" OR Action$ = "/?" THEN
PRINT
PRINT "BBB - Brent's Batch Beautifier v2.0 by Brent Ashley"
PRINT "Syntax: BBB Action [Parm1 [Parm2...]] [Action...]
PRINT "- Action can be long or short form as below:"
PRINT " ANSITEST BOLD/! UNDERLINE/_ BLINK/; REVERSE/* RESET/^"
PRINT " CLEAR/# CLREOL/) SAVE/{ RESTORE/} LOCATE/@ Row Col"
PRINT " MODE/M {M40|M80|C40|C80}"
PRINT " COLOR Fore Back"
PRINT " (BLACK/0 RED/1 GREEN/2 YELLOW/3 BLUE/4 MAGENTA/5 CYAN/6 WHITE/7)"
PRINT " BOX/B Tp Lt Bt Rt {FILL/F|EMPTY/E} {SINGLE/S|DOUBLE/D|BLOCK/B|CHAR/C nnn}"
PRINT " SAY/? All text up to tilde~"
PRINT " STRING/$ String up to tilde~ Repeats"
PRINT " ENTER/E FLUSH/F BEEP/+ TIME/T DATE/D GAUGE/G Percent"
PRINT " WEEKDAY/W (returns ERRORLEVEL 0:Sunday to 6:Saturday)"
PRINT " ALARM/A Repeats (Repeats=0 to wait for keypress)"
PRINT " PAUSE/P Seconds (Seconds=0 to wait for keypress)"
PRINT " INPUT/I EnvironmentVariableName UPCASE/U EnvironmentVariableName"
PRINT " QUERY/Q ValidString (ERRORLEVEL=stringposition)"
PRINT " STUFF text up to tilde~ (&=return)
PRINT " PRTSCR ON|OFF BOOT [COLD]"
END
END IF
DO ' main program loop
' init ANSI code to send
Code$ = ""
SELECT CASE UCASE$(Action$)
CASE "ANSITEST"
' Check for ANSI.SYS using same method as COMMAND.COM
DEF SEG = 0
Int29Seg& = PEEK(166) + 256 * PEEK(167)
IF Int29Seg& < 0 THEN Int29Seg& = Int29Seg& + 65536
Int20Seg& = PEEK(130) + 256 * PEEK(131)
IF Int20Seg& < 0 THEN Int20Seg& = Int20Seg& + 65536
IF Int29Seg& <= Int20Seg& THEN
PRINT "BBB - ANSI.SYS not installed!"
ErrorLevel = 1
ELSE
PRINT "BBB - ANSI.SYS is loaded."
ErrorLevel = 0
END IF
EndLevel ErrorLevel
CASE "BOOT"
DEF SEG = 0
IF UCASE$(PDQParse(CmdLine$)) = "COLD" THEN
PDQPoke2 &H472, 0
ELSE
PDQPoke2 &H472, &H1234
ENDIF
DEF SEG = &HFFFF
CALL ABSOLUTE(0)
CASE "BOLD", "!"
Code$ = "1m"
CASE "UNDERLINE", "_"
Code$ = "4m"
CASE "BLINK", ";"
Code$ = "5m"
CASE "REVERSE", "*"
Code$ = "7m"
CASE "RESET", "^"
Code$ = "0m"
CASE "COLOR", "C"
Parm$(1) = PDQParse(CmdLine$) ' fore
Parm$(2) = PDQParse(CmdLine$) ' back
FOR i = 1 TO 2
' translate color
SELECT CASE UCASE$(Parm$(i))
CASE "RED", "1"
ColorVal = 1
CASE "GREEN", "2"
ColorVal = 2
CASE "YELLOW", "3"
ColorVal = 3
CASE "BLUE", "4"
ColorVal = 4
CASE "MAGENTA", "5"
ColorVal = 5
CASE "CYAN", "6"
ColorVal = 6
CASE "WHITE", "7"
ColorVal = 7
CASE ELSE
ColorVal = 0
END SELECT
IF i = 1 THEN
Parm$(i) = STR$(30 + ColorVal) ' fore
ELSE
Parm$(i) = STR$(40 + ColorVal) ' back
ENDIF
NEXT
Code$ = Parm$(1) + ";" + Parm$(2) + "m"
CASE "LOCATE", "@"
Parm$(1) = PDQParse(CmdLine$) ' row
Parm$(2) = PDQParse(CmdLine$) ' column
Code$ = Parm$(1) + ";" + Parm$(2) +"H"
CASE "CLREOL", ")"
Code$ = "K"
CASE "SAVE", "{"
Code$ = "s"
CASE "RESTORE", "}"
Code$ = "u"
CASE "CLEAR", "#"
Code$ = "2J"
CASE "MODE", "M"
Parm$(1) = PDQParse(CmdLine$)
SELECT CASE UCASE$(Parm$(1))
CASE "M40"
Mode$ = "0h"
CASE "M80"
Mode$ = "2h"
CASE "C40"
Mode$ = "1h"
CASE ELSE
Mode$ = "3h"
END SELECT
Code$ = "=" + Mode$
CASE "BOX", "B"
Top = PDQValI(PDQParse(CmdLine$))
Lft = PDQValI(PDQParse(CmdLine$))
Bot = PDQValI(PDQParse(CmdLine$))
Rgt = PDQValI(PDQParse(CmdLine$))
Fill$ = UCASE$(PDQParse(CmdLine$))
Style$ = (PDQParse(CmdLine$))
SELECT CASE UCASE$(Style$)
CASE "DOUBLE", "D"
BoxType = 2
CASE "BLOCK", "B"
BoxType = 3
CASE "CHAR", "C"
BoxChar$ = PDQParse(CmdLine$)
BoxType = 4
Box$(4) = ""
FOR i = 1 TO 6
Box$(4) = Box$(4) + BoxChar$ + " "
NEXT
CASE ELSE
' default to single
BoxType = 1
END SELECT
Wide = Rgt - Lft - 1
IF (Wide > 0) AND (Top < Bot) THEN
PRINT Prefix$; "s"; ' save cursor position
' top line
Row = Top: Col = Lft: GOSUB CursorLoc
PRINT FNBorder$(1); STRING$(Wide,FNBorder$(5)); FNBorder$(2);
' middle lines
FOR i = Top + 1 To Bot - 1
Row = i: Col = Lft: GOSUB CursorLoc
PRINT FNBorder$(6);
IF Fill$ = "F" or Fill$ = "FILL" THEN PRINT SPACE$(Wide);
Row = i: Col = Rgt: Gosub CursorLoc
PRINT FNBorder$(6);
NEXT
' bottom line
Row = Bot: Col = Lft: GOSUB CursorLoc
PRINT FNBorder$(3); STRING$(Wide,FNBorder$(5)); FNBorder$(4);
' restore cursor position
PRINT Prefix$; "u";
END IF
CASE "SAY", "?"
SetDelimitChar 126 ' tilde (~)
PRINT PDQParse(CmdLine$);
SetDelimitChar 32 ' space
CASE "STRING", "$"
SetDelimitChar 126 ' tilde (~)
Parm$(1) = PDQParse(CmdLine$)
SetDelimitChar 32 ' space
Repeat = PDQValI(PDQParse(CmdLine$))
' build repeated string
Result$ = ""
FOR i = 1 TO Repeat
Result$ = Result$ + Parm$(1)
NEXT
PRINT Result$;
CASE "PAUSE", "P"
' multiply time by 18.2 for ticks to seconds conversion
PauseTime = (PDQValI(PDQParse(CmdLine$)) * 182) \ 10
IF PauseTime = 0 THEN ' wait for key
DO: LOOP WHILE INKEY$ = ""
ELSE
Pause PauseTime
ENDIF
CASE "ENTER", "E"
PRINT
CASE "FLUSH", "F"
WHILE INKEY$ <> "": WEND
CASE "BEEP", "+"
BEEP
Pause 2
CASE "ALARM", "A"
Repeats = PDQValI(PDQParse(CmdLine$))
i = 0
DO
IF Repeats = 0 THEN
IF INKEY$<>"" THEN EXIT DO
ELSE
i = i + 1
IF i > Repeats THEN EXIT DO
ENDIF
PDQSound 523, 3
PDQSound 659, 3
PDQSound 784, 3
LOOP
CASE "DATE", "D"
PRINT DATE$;
CASE "TIME", "T"
PRINT TIME$;
CASE "WEEKDAY", "W"
Regs.AX = &H2A00
INTERRUPT &H21, Regs
WeekDay = Regs.AX MOD 256
EndLevel WeekDay
CASE "GAUGE", "G"
Gauge = PDQValI(PDQParse(CmdLine$))\2 MOD 100
' print gas gauge
PRINT STRING$(Gauge,219); STRING$(50 - Gauge,177);
CASE "INPUT", "I"
VarName$ = PDQParse(CmdLine$)
PDQInput VarValue$
EnvCall$ = VarName$ + "=" + VarValue$
ENVIRON EnvCall$
IF ERR = 105 THEN
PRINT Prefix$; "s";
Row = 25: Col = 1: GOSUB CursorLoc
PRINT "BBB - not enough DOS environment space"
PRINT Prefix$; "u";
END IF
CASE "QUERY","Q"
Parm$(1) = UCASE$(PDQParse(CmdLine$)) ' valid string
DO
' wait for keypress
KeyPress$=""
DO
KeyPress$ = UCASE$(INKEY$)
LOOP WHILE KeyPress$=""
Posn = INSTR(Parm$(1), KeyPress$)
If Posn <> 0 THEN ' within valid string?
EndLevel Posn ' key valid
ELSE
BEEP ' key invalid
END IF
LOOP
CASE "UPCASE", "U"
Parm$(1) = UCASE$(PDQParse(CmdLine$)) ' var name
EnvCall$ = Parm$(1) + "=" + UCASE$(ENVIRON$(Parm$(1)))
ENVIRON EnvCall$
CASE "STUFF"
SetDelimitChar 126
Parm$(1) = PDQParse(CmdLine$)
SetDelimitChar 32
FOR i = 1 to LEN(Parm$(1))
IF MID$(Parm$(1),i,1) = "&" THEN MID$(Parm$(1),i,1) = CHR$(13)
NEXT
StuffBuf Parm$(1)
CASE "PRTSCR"
IF UCASE$(PDQParse(CmdLine$))="OFF" THEN PokeVal=1 ELSE PokeVal=0
DEF SEG = 0
POKE &H500, PokeVal
CASE "" ' no more actions on command line
END
CASE ELSE
' invalid command - print message at 25,1
PRINT Prefix$; "s";
Row = 25: Col = 1: GOSUB CursorLoc
PRINT "Invalid BBB command: "; Action$;
PRINT Prefix$; "u";
END SELECT
' see if ANSI code to be printed
IF Code$ <> "" THEN PRINT Prefix$; Code$;
' get next action
Action$ = PDQParse(CmdLine$)
LOOP
CursorLoc:
' reposition cursor via ANSI codes
RowStr$ = STR$(Row)
ColStr$ = STR$(Col)
PRINT Prefix$; RowStr$; ";"; ColStr$; "H";
RETURN